home *** CD-ROM | disk | FTP | other *** search
- -> landscape test
-
- OPT OSVERSION=39
-
- CONST CWIDTH=256,CHEIGHT=128,CWSHIFT=8
- CONST SCHEIGHT=CHEIGHT+20
- CONST TEMPBUFS=CWIDTH*CHEIGHT/2,BUFS=CWIDTH*CHEIGHT,BUFM=$7FFF
- CONST SXOFF=50,SYOFF=80
-
- MODULE '*c2p4', '*screenmodereq_db', 'tools/exceptions', 'tools/scrbuffer',
- 'intuition/screens', 'graphics/rastport', 'graphics/gfx',
- 'intuition/intuition'
-
- PROC main() HANDLE
- DEF dbs,scr=NIL:PTR TO screen,bm:PTR TO bitmap,win=NIL:PTR TO window,
- tbuf2,tbuf3,tbuf2b,tbuf3b,cbuf,dbuf,dbuf2,lsbuf,sigbit,sig,safe=TRUE,a,x=0,y=0,
- imsg:PTR TO intuimessage,temp
- IF (dbs:=openreqscreen(CWIDTH,SCHEIGHT,4,'bla'))=NIL THEN Raise()
- scr:=sb_GetScreen(dbs)
- IF (win:=OpenW(0,0,CWIDTH-1,SCHEIGHT-1,
- IDCMP_MOUSEBUTTONS OR IDCMP_MOUSEMOVE,
- WFLG_REPORTMOUSE OR WFLG_BORDERLESS OR WFLG_SIMPLE_REFRESH OR WFLG_BACKDROP OR WFLG_ACTIVATE,
- '',scr,15,NIL))=NIL THEN Raise("WIN")
- tbuf2:=NewM(TEMPBUFS+TEMPBUFS,2)
- tbuf3:=tbuf2+TEMPBUFS
- tbuf2b:=NewM(TEMPBUFS+TEMPBUFS,2)
- tbuf3b:=tbuf2b+TEMPBUFS
- NEW cbuf[BUFS]
- NEW dbuf[BUFS]
- NEW dbuf2[BUFS]
- NEW lsbuf[BUFS]
- FOR a:=0 TO BUFS-1
- dbuf[a]:=-1
- dbuf2[a]:=-1
- ENDFOR
- FOR a:=0 TO 15 DO SetColour(scr,15-a,a*16,a*16,a*16)
- mountain(cbuf)
- CopyMem(cbuf,lsbuf,BUFS)
- SetRast(scr.rastport,0)
- IF (sigbit:=AllocSignal(-1))<>-1
- sig:=Shl(1,sigbit)
- REPEAT
- render(cbuf,lsbuf,CWIDTH*y+x,80,80)
- x:=x+2
- y:=y+3
- IF safe=FALSE
- Wait(sig)
- safe:=TRUE
- ENDIF
- bm:=sb_NextBuffer(dbs)
- ->SetColour(scr,15,f:=255-f,f,f)
- c2p4(tbuf3,tbuf2,cbuf,dbuf,bm.planes,FindTask(NIL),sig,gfxbase)
- temp:=dbuf; dbuf:=dbuf2; dbuf2:=temp
- temp:=tbuf2; tbuf2:=tbuf2b; tbuf2b:=temp
- temp:=tbuf3; tbuf3:=tbuf3b; tbuf3b:=temp
- IF imsg:=GetMsg(win.userport)
- x:=0-imsg.mousex
- y:=0-imsg.mousey
- ReplyMsg(imsg)
- ENDIF
- safe:=FALSE
- UNTIL Mouse()
- IF safe=FALSE THEN Wait(sig)
- FreeSignal(sigbit)
- ENDIF
- EXCEPT DO
- IF win THEN CloseWindow(win)
- closereqscreen(dbs)
- SELECT exception
- CASE "SCR"; WriteF('no screen!\n')
- CASE "REQ"; WriteF('Error: Could not allocate ASL request\n')
- CASE "ASL"; WriteF('Error: Could not open ASL library\n')
- ENDSELECT
- report_exception()
- ENDPROC
-
- PROC mountain(buf)
- DEF a,x,y
- FOR a:=0 TO BUFS-1
- y:=a/CWIDTH; x:=Mod(a,CWIDTH)
- buf[a]:=Bounds(
- ((x-128)*(x-128))+((y-64)*(y-64))/300,
- ->x*y/300,
- ->!(!Fsin(x!/10.0)*3.0+3.0)+(!Fsin(y!/10.0)*3.0+3.0)!,
- ->!Fsin(x!/10.0)*6.0*Fsin(y!/10.0)+5.0!,
- 0,15)
- ENDFOR
- ENDPROC
-
- PROC render(destbuf,lsbuf,offs,xs,ys)
- DEF a,t1,t2
- clearmem(destbuf,BUFS)
- t1:=ys-1*CWIDTH-1+offs
- t2:=xs-1+offs
- FOR a:=1 TO xs DO line(a,t1+a AND BUFM,a+SXOFF,a/2+SYOFF,destbuf,lsbuf)
- FOR a:=ys-1 TO 1 STEP -1 DO line(a,a-1*CWIDTH+t2 AND BUFM,xs*2+SXOFF-a,a/2+SYOFF,destbuf,lsbuf)
- ENDPROC
-
- PROC clearmem(mem,size)
- DEF e:REG,a:REG,b:REG,c:REG,d:REG
- e:=size/16-1
- a:=b:=c:=d:=$04040404
- MOVE.L mem,A0
- ADD.L size,A0
- clloop:
- MOVEM.L a/b/c/d,-(A0)
- DBRA e,clloop
- ENDPROC
-
- PROC line(num,start,sx,sy,destbuf,lsbuf)
- DEF a:REG,y,t:REG,c=0:REG,xoff:REG,yoff:REG
- xoff:=sx+destbuf
- yoff:=sy-25-num+1
- y:=sy*CWIDTH+xoff
- a:=num-1+yoff
- MOVE.L start,D2 -> D2=start
- MOVEA.L lsbuf,A3 -> A3=lsbuf
- MOVE.L y,A2 -> A2=y
- MOVE.L #CWIDTH,D1 -> D1=CWIDTH
- MOVE.L #BUFM,D0 -> D0=BUFM
- MOVE.L #CWIDTH+1,A1 -> A1=CWIDTH+1
- bloop: -> this loop eats almost all cpu-time.
- MOVE.B 0(A3,D2.L),c
- MOVE.L a,t
- ADD.L c,t
- LSL.L #CWSHIFT,t
- ADD.L xoff,t
- CMP.L A2,t
- BGE.S skip
- BRA.S loop
- begi:
- SUBA.L D1,A2
- MOVE.B c,(A2)
- loop:
- CMP.L A2,t
- BMI.S begi
- skip:
- SUB.L A1,D2
- AND.L D0,D2
- SUBQ.L #1,a
- CMP.L yoff,a
- BPL.S bloop
- ENDPROC
-